home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / FILL.I < prev    next >
Text File  |  1991-12-14  |  3KB  |  121 lines
  1. IMPLEMENTATION MODULE Fill;
  2.  
  3. IMPORT CommonData;
  4. IMPORT MagicAES;
  5. IMPORT MagicVDI;
  6. IMPORT mtAppl;
  7. (**
  8. IMPORT GEMError;
  9. IMPORT RTD;
  10. **)
  11. (* -------------------------------------------------------------- *)
  12. (*      Initialisierung des selbst erzeugten Füllpatterns         *)
  13. (* -------------------------------------------------------------- *)
  14.  
  15. (* Setze den VDI-Fill-Modus (eigene Definition für left *)
  16. VAR LeftPattern : ARRAY [1..1],[1..16] OF INTEGER;
  17.  
  18. (**
  19. PROCEDURE SetUserfillpattern (handle: sINTEGER; VAR pat: ARRAY OF LOC);
  20. VAR old: ADDRESS;
  21. BEGIN
  22.  old:= VDIPB.intin;
  23.  VDIPB.intin:= ADR (pat);
  24.  VDICall (112, 0, HIGH(pat) * 16, 0, handle);
  25.  VDIPB.intin:= old;
  26. END SetUserfillpattern;
  27. **)
  28.  
  29. PROCEDURE SetFillPattern;
  30. CONST abstand = 2;
  31. VAR i : INTEGER;
  32.     b : BITSET;
  33.  
  34.   PROCEDURE MakePattern (startbit : INTEGER);
  35.   VAR j, k : INTEGER;
  36.   BEGIN
  37.     b := BITSET{}; (* löschen *)
  38.     k := 0;
  39.     REPEAT
  40.       j := startbit;
  41.       (*
  42.          Das ganze muß jetzt geeignet aufbereitet werden,
  43.          da das Pattern in Intel-Konvention erwartet wird.
  44.       *)
  45.       IF j>7 THEN
  46.         (* MSB first *)
  47.         INCL(b, j - 8);
  48.        ELSE
  49.         (* LSB last *)
  50.         INCL(b, j + 8);
  51.       END;
  52.       INC(j, abstand);
  53.       INC(k, 1);
  54.       IF (j>15) THEN
  55.         DEC(j, 16);
  56.       END;
  57.     UNTIL (k >= 16 DIV abstand);
  58.   END MakePattern;
  59.  
  60. BEGIN
  61.   FOR i:=1 TO 16 DO
  62.     LeftPattern[1, i] := 0;
  63.   END;
  64.   
  65.   FOR i:=1 TO 16 DO
  66.     MakePattern(16-i);
  67.     LeftPattern[1, i] := INTEGER(b);
  68.   END;
  69.   (* Einfaches Muster von links oben nach rechts unten *)
  70. END SetFillPattern;
  71.  
  72. PROCEDURE SetFillMode ( FillMode : INTEGER) ;
  73. (*
  74.    Setze Fill-Modus (wie oben angegeben)
  75. *)
  76. VAR fillstyle, fillstyleindex, dum : INTEGER;
  77. BEGIN
  78.   (* Hatch mode *)
  79.   fillstyle := MagicVDI.Hatch;
  80.   CASE FillMode OF
  81.     0 : fillstyle      :=  MagicVDI.Full;
  82.         fillstyleindex := -1;| (* paint *)
  83.     1 : fillstyleindex := 5; | (* hor *)
  84.     2 : fillstyleindex := 4; | (* ver *)
  85.     3 : fillstyleindex := 6; | (* horver *)
  86. (** Original, führt nun nicht mehr zu Abstürzen... **)
  87.     4 : fillstyle      := MagicVDI.UserFill;
  88.         fillstyleindex :=-1; | (* User Def *)
  89. (**)
  90. (** Hilfsversion **
  91.     4 : fillstyleindex := 1; | (* User Def *)
  92. **)
  93.     5 : fillstyleindex := 1; | (* right *)
  94.     6 : fillstyleindex := 3; | (* leftright *)
  95.    ELSE
  96.     fillstyle      :=  MagicVDI.None; (* hollow *)
  97.     fillstyleindex := -1;
  98.   END;
  99.   dum := MagicVDI.SetFillinterior  (mtAppl.VDIHandle , fillstyle);
  100.   IF fillstyle=MagicVDI.UserFill THEN
  101.     (* nur 1 Plane *)
  102.     MagicVDI.SetUserfillpattern(mtAppl.VDIHandle, LeftPattern);
  103.    ELSE
  104.     IF fillstyleindex>0 THEN
  105.       dum := MagicVDI.SetFillstyle(mtAppl.VDIHandle, fillstyleindex);
  106.     END;
  107.   END;
  108.   dum := MagicVDI.SetFillcolor (mtAppl.VDIHandle , MagicAES.BLACK);
  109. END SetFillMode;
  110.  
  111. BEGIN
  112. (**
  113.   RTD.Into('Mod.Fill');
  114. **)
  115.   SetFillPattern;
  116. (**
  117.   RTD.Leaving('Mod.Fill');
  118. **)
  119. END (* of definition module *) Fill .
  120.  
  121.